--
--  Copyright 2014 Alessandro Gerlinger Romero
--
--  This file is part of Hybrid fUML.
--
--  Hybrid fUML is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 3 of the License, or
--  (at your option) any later version.
--  
--  Hybrid fUML is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--  
--  You should have received a copy of the GNU General Public License
--  along with Hybrid fUML. If not, see <http://www.gnu.org/licenses/>.
--

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- APPROACH
-- explicity model hybrid clock
--		with reaction time, physical time and logical time
--
-- ACCORDING MARTE

-- IMPORTANT - parser is very simple... it is not in the hard part... however, it should parse the basic elements to allow evaluation of the semantics

-- FULLY EMBEDDED
-------------------------------------------------------------

--
-- derived function in the meta-model
function_Clock_currentTime :: FUML_Semantics_Extensions_Clock_Clock -> Float
function_Clock_currentTime c = function_fUML_currentTimeFloat (function_Clock_timeBase c)

--
-- defined by symmetric relation, otherwise it was not possible because it would always cause inconsistent updates in the ASM
--

-- ATTENTION: it relies on the Ord defined for the DOM
function_TimeBase_instants :: FUML_Semantics_Extensions_Clock_TimeBase -> [FUML_Semantics_Extensions_Clock_Instant]
function_TimeBase_instants tb = filter (\i -> (function_Instant_tb i) == tb ) $ expr2list $ dom function_Instant_tb

function_MultipleTimeBase_ownedTBs :: FUML_Semantics_Extensions_Clock_MultipleTimeBase -> {FUML_Semantics_Extensions_Clock_TimeBase}
function_MultipleTimeBase_ownedTBs mtb =  mkSet $ filter (\tb -> (function_TimeBase_owningMTB tb) == mtb ) $ expr2list $ dom function_TimeBase_owningMTB

function_Locus_logicalClocks :: 	FUML_Semantics_Loci_LociL1_Locus -> {FUML_Semantics_Extensions_Clock_Clock}
function_Locus_logicalClocks l = mkSet $ filter (\clk -> (function_Clock_LogicalClock_locus clk) == l ) $ expr2list $ dom function_Clock_LogicalClock_locus 
--
--

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- HELP FUNCTIONs

function_fUML_currentTimeFloat :: FUML_Semantics_Extensions_Clock_TimeBase -> Float 
function_fUML_currentTimeFloat tb = function_Instant_date $ function_TimeBase_currentInstant tb

function_fUML_currentTimeInt :: FUML_Semantics_Extensions_Clock_TimeBase -> Int 
function_fUML_currentTimeInt tb = truncate $ function_Instant_date $ function_TimeBase_currentInstant tb

function_fUML_Clock_currentTimeInt :: FUML_Semantics_Extensions_Clock_Clock -> Int
function_fUML_Clock_currentTimeInt c = function_fUML_currentTimeInt (function_Clock_timeBase c)

function_fUML_Clock_currentTimeFloat :: FUML_Semantics_Extensions_Clock_Clock -> Float
function_fUML_Clock_currentTimeFloat c = function_fUML_currentTimeFloat (function_Clock_timeBase c)

--
-- used to check if a clock evolve during one reaction
function_fUML_Clock_isDesynchronized :: FUML_Semantics_Extensions_Clock_Clock -> Bool
function_fUML_Clock_isDesynchronized c = function_TimeBase_currentInstant(function_Clock_timeBase c) /= last (function_TimeBase_instants (function_Clock_timeBase c)) 

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- EVENT

-- EVENT used by the semantics
function_Instance_Event_semanticEventForReactionClk ::FUML_Syntax_CommonBehaviors_Communications_Event
function_Instance_Event_semanticEventForReactionClk = FUML_Syntax_CommonBehaviors_Communications_Event "reactionClk" "reactionClk" FUML_Syntax_Classes_Kernel_VisibilityKind_public FUML_Syntax_Classes_Kernel_VisibilityKind_public FUML_Syntax_Classes_Kernel_ClassifierEmpty FUML_Syntax_CommonBehaviors_Communications_SignalEvent 

-- EVENT used by the semantics
function_Instance_Event_semanticEventForLogicalClk ::FUML_Syntax_CommonBehaviors_Communications_Event
function_Instance_Event_semanticEventForLogicalClk = FUML_Syntax_CommonBehaviors_Communications_Event "logicalClk" "logicalClk" FUML_Syntax_Classes_Kernel_VisibilityKind_public FUML_Syntax_Classes_Kernel_VisibilityKind_public FUML_Syntax_Classes_Kernel_ClassifierEmpty FUML_Syntax_CommonBehaviors_Communications_SignalEvent 

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- BASIC PARSER FUNCTIONS FOR CCSL
-- OBS: ONLY TO SUPPORT EVALUATION OF THE SEMANTICS
--

--
-- look for a CCSL that has the reactionClk and the physicalClk
-- it covers models that does not model a explicit signal
-- this patter is expected:
-- Clock c; c isPeriodicOn physicalClk period <nn>; c = <name of definingEvent>;
function_fUML_Clock_getPeriod :: FUML_Semantics_Extensions_Clock_Clock -> Int
function_fUML_Clock_getPeriod c = let ccsls = function_fUML_parseCCSLs in
							  let eventName = function_Event_NamedElement_name (function_Clock_LogicalClock_definingEvent c) ++ ";" in
							  let physClk = filter (\c -> elem "physicalClk" c) ccsls in
							  let eventClk = filter (\c -> elem eventName c) physClk in
							  let ei = length eventClk == 1 in
							  let c = head eventClk in
							  if ei then
							  	let per = findPosA c "period" in
							  	let perv = init(takeUntil (\c -> c == ';') (c!!(per+1))) in 
							  	if per < length c then
							  		str2int perv
							  	else 0
							  else 0  

function_fUML_Clock_getPeriodWithDefault :: FUML_Semantics_Extensions_Clock_Clock -> Int
function_fUML_Clock_getPeriodWithDefault c = 
							  let l = function_Clock_LogicalClock_locus(c) in
							  let defaultPeriod = function_Locus_defaultPeriod2ReactionClk l in
							  let reactionClk = function_Locus_reactionClock l in
							  let period = function_fUML_Clock_getPeriod c in
							  -- used to allow continuous behavior without explicit relationship with reactionClck
							  if c == reactionClk && period == 0 then
							  	 -- -1 defines that the edge for the evolution of physical clock is unlimited 
							  	 if defaultPeriod == -1 then
							  	 	1
							  	 else
							  		defaultPeriod
							  else 
							  		period 

--
-- look for a CCSL that has physicalClk and the definingEvent
function_fUML_Clock_isRelatedWithPhysicalClk :: FUML_Semantics_Extensions_Clock_Clock -> Bool
function_fUML_Clock_isRelatedWithPhysicalClk c = if function_fUML_Clock_getPeriod c > 0 || function_Clock_LogicalClock_definingEvent c == function_Instance_Event_semanticEventForReactionClk then True else False

--
-- look for a CCSL that has reactionClk and the definingEvent
-- this patter is expected:
-- c1 isCoarserThan reactionClk; c1 = PlantInRangeEvent;
function_fUML_Clock_isRelatedWithReactionClk :: FUML_Semantics_Extensions_Clock_Clock -> Bool
function_fUML_Clock_isRelatedWithReactionClk c = 
							  let ccsls = function_fUML_parseCCSLs in
							  let eventName = function_Event_NamedElement_name (function_Clock_LogicalClock_definingEvent c) ++ ";" in
							  let reactionClk = filter (\c -> elem "reactionClk;" c) ccsls in
							  let eventClk = filter (\c -> elem eventName c) reactionClk in
							  if length eventClk == 1 then True else False

-- parse every CCSL in a set of words
function_fUML_parseCCSLs :: [[String]]
function_fUML_parseCCSLs = let cs = function_Constraint_InverseAppliedStereotype ClockConstraint in
							  let vs = map (\c -> 
							  							let vs = function_Constraint_specification c in
							  							let vt = function_ValueSpecification_type vs in
						 								if vs /= FUML_Syntax_Classes_Kernel_ValueSpecificationEmpty && vt == FUML_Syntax_Classes_Kernel_LiteralString then
							  								words (function_ValueSpecification_LiteralString_value vs)
							  							else
							  								[] 
							  							 ) (expr2list cs) in
							  vs	

--
-- look for a CCSL that has idealCk and discretizedBy
-- then reads the step(resolution)							  
function_fUML_getResolutionPhysicalClk :: Float
function_fUML_getResolutionPhysicalClk = let ccsls = function_fUML_parseCCSLs in
							  let idealClk = filter (\c -> elem "idealClk" c) ccsls in
							  let ei = length idealClk == 1 in
							  let c = head idealClk in
							  if ei then
							  	let dis = findPosA c "discretizedBy" in
							  	let step = init(takeUntil (\c -> c == ';') (c!!(dis+1))) in 
							  	if dis < length c then
							  		function_fUML_StringToFloat step
							  	else 
							  		0.0
							  else 0.0  

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- HELP FUNCTION
				
-- 							  
function_fUML_StringToFloat :: String -> Float
function_fUML_StringToFloat str = 
							  	let strin = init(takeUntil (\c -> c == '.') (str)) in
							  	let strdec = tail(dropWhile (\c -> c /= '.') (str)) in
							  	primIntToFloat ( str2int strin ) + (primIntToFloat ( str2int strdec ) / (10.0^(length strdec)))  

--
-- find the position of a string in an array of strings							  
findPosA :: [String] -> String -> Int 
findPosA list elem 
	       | head list == elem = 0
	       | otherwise = 1 + (findPosA (tail list) elem)